home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / defoma / scripts / psfontmgr.defoma < prev    next >
Encoding:
Text File  |  2006-06-17  |  7.3 KB  |  359 lines
  1. @ACCEPT_CATEGORIES = qw(pspreview type1 xfont postscript);
  2.  
  3. package psfontmgr;
  4. use strict;
  5. use POSIX;
  6. use Debian::Defoma::Common;
  7. use Debian::Defoma::Font;
  8. use Debian::Defoma::Id;
  9. use Debian::Defoma::Subst;
  10. import Debian::Defoma::Common;
  11. import Debian::Defoma::Font;
  12. import Debian::Defoma::Id;
  13. import Debian::Defoma::Subst;
  14.  
  15. use vars qw($ROOTDIR $DEFOMA_TEST_DIR);
  16.  
  17. my $pkgdir = "$ROOTDIR/psfontmgr.d";
  18. my $hintfile = "$pkgdir/ps-hints.private-cache";
  19.  
  20. my ($IdObjH, $IdX);
  21. my %Sb;
  22.  
  23. sub init {
  24.     unless($IdObjH) {
  25.     $IdObjH = defoma_id_open_cache();
  26.     }
  27.     unless($IdX) {
  28.     $IdX = defoma_id_open_cache('X');
  29.     }
  30.     
  31.     return 0;
  32. }
  33.  
  34. sub term {
  35.     my @l = keys(%Sb);
  36.     foreach my $s (@l) {
  37.     defoma_subst_close($Sb{$s});
  38.     delete($Sb{$s});
  39.     }
  40.     if ($IdX) {
  41.     defoma_id_close_cache($IdX);
  42.     $IdX = 0;
  43.     }
  44.     if ($IdObjH) {
  45.     my @list = defoma_id_grep_cache($IdObjH, 'installed');
  46.  
  47.     if (open(F, '>' . $hintfile)) {
  48.         foreach my $i (@list) {
  49.         my $h = join(' ', defoma_id_get_hints($IdObjH, $i));
  50.         print F $IdObjH->{0}->[$i], ' ', $h, "\n";
  51.         }
  52.         close F;
  53.     }
  54.  
  55.     defoma_id_close_cache($IdObjH);
  56.     $IdObjH = 0;
  57.     }
  58.  
  59.     return 0;
  60. }
  61.  
  62. sub check_subst_cache {
  63.     my $cset = shift;
  64.  
  65.     unless (exists($Sb{$cset})) {
  66.     my $rulename = 'xps.'.$cset;
  67.     $Sb{$cset} = defoma_subst_open(rulename => $rulename, threshold => 70,
  68.                        idobject => $IdX, private => 1);
  69.     }
  70. }
  71.  
  72. ###
  73.  
  74. sub postscript_register {
  75.     my $font = shift;
  76.     $font =~ /([^\/]+)\/([^\/]+)/;
  77.     my $fontname = $2;
  78.  
  79.     defoma_id_register($IdObjH, type => 'real', font => $font, id => $fontname,
  80.                priority => 0, hints => join(' ', @_));
  81.     
  82.     return 0;
  83. }
  84.  
  85. sub postscript_unregister {
  86.     my $font = shift;
  87.     
  88.     defoma_id_unregister($IdObjH, type => 'real', font => $font);
  89.  
  90.     return 0;
  91. }
  92.  
  93. sub postscript_install {
  94.     my $font = shift;
  95.     my $id = shift;
  96.     shift;
  97.     shift;
  98.  
  99.     my $h = parse_hints_start(@_);
  100.     my $cset = $h->{Charset} || return 0;
  101.     $cset =~ s/ .*//;
  102.  
  103.     my @rule;
  104.  
  105.     my $gfamily = $h->{GeneralFamily};
  106.     my $family = $h->{Family};
  107.     my $weight = $h->{Weight};
  108.     my $shape = $h->{Shape};
  109.     my $width = $h->{Width};
  110.     my $unicset = $h->{UniCharset};
  111.     my $fontname = $h->{FontName};
  112.  
  113.     my %rule;
  114.     $rule{'Shape,2'} = $shape if ($shape);
  115.     $rule{'Width'} = $width if ($width);
  116.     $rule{'Weight,2'} = $weight if ($weight);
  117.     $rule{'GeneralFamily,2'} = $gfamily if ($gfamily);
  118.     $rule{'FontName,2'} = $fontname if ($fontname);
  119.  
  120.     $rule{'Family,*'} = $family if ($cset eq 'font-specific' && $family);
  121.     $rule{'UniCharset,*'} = $unicset if ($cset eq 'ISO10646-1' && $unicset);
  122.  
  123.     check_subst_cache($cset);
  124.     defoma_subst_add_rule($Sb{$cset}, $id, parse_hints_build(\%rule));
  125.     
  126.     return 0;
  127. }
  128.  
  129. sub postscript_remove {
  130.     my $font = shift;
  131.     my $id = shift;
  132.     shift;
  133.     shift;
  134.  
  135.     my $h = parse_hints_start(@_);
  136.     my $cset = $h->{Charset} || return 0;
  137.     $cset =~ s/ .*//;
  138.  
  139.     check_subst_cache($cset);
  140.     defoma_subst_remove_rule($Sb{$cset}, $id);
  141.  
  142.     return 0;
  143. }
  144.  
  145. sub postscript {
  146.     my $com = shift;
  147.  
  148.     if ($com eq 'register') {
  149.     return postscript_register(@_);
  150.     } elsif ($com eq 'unregister') {
  151.     return postscript_unregister(@_);
  152.     } elsif ($com eq 'do-install-real') {
  153.     return postscript_install(@_);
  154.     } elsif ($com eq 'do-remove-real') {
  155.     return postscript_remove(@_);
  156.     } elsif ($com eq 'init') {
  157.     return init();
  158.     } elsif ($com eq 'term') {
  159.     return term();
  160.     }
  161.  
  162.     return 0;
  163. }
  164.  
  165. sub pspreview {
  166.     my $com = shift;
  167.     my $font = shift;
  168.  
  169.     if ($com eq 'register') {
  170.     defoma_font_register('postscript', '_' . $font, @_);
  171.     return 0;
  172.     } elsif ($com eq 'unregister') {
  173.     if (defoma_font_if_register('postscript', '_' . $font)) {
  174.         defoma_font_unregister('postscript', '_' . $font);
  175.     }
  176.     return 0;
  177.     } elsif ($com eq 'init') {
  178.     return init();
  179.     } elsif ($com eq 'term') {
  180.     return term();
  181.     }
  182.  
  183.     return 0;
  184. }
  185.  
  186. ###
  187.  
  188. sub x_register {
  189.     my $font = shift;
  190.     my $hh = parse_hints_start(@_);
  191.     my $facenum = $hh->{FaceNum} || 1;
  192.  
  193.     parse_hints_cut($hh, 'FaceNum');
  194.  
  195.     my $error = 0;
  196.     my $noerror = 0;
  197.     
  198.     for (my $f = 0; $f < $facenum; $f++) {
  199.     my $h = parse_hints_subhints_inherit($hh, $f);
  200.  
  201.     my $xfont = $h->{'X-FontName'};
  202.     my $charset = $h->{Charset};
  203.  
  204.     unless ($xfont && $charset) {
  205.         $error = 1;
  206.         next;
  207.     }
  208.  
  209.     $xfont =~ s/ .*//;
  210.     $charset =~ s/ .*//;
  211.  
  212.     my $priority = $h->{Priority} || 0;
  213.  
  214.     parse_hints_cut_except($h, 'GeneralFamily', 'Family', 'Weight',
  215.                    'Shape', 'Width', 'FontName');
  216.     my @hints = parse_hints_build($h);
  217.     
  218.     defoma_id_register($IdX, type => 'real', font => $font, id => $xfont,
  219.                priority => $priority,
  220.                hints => join(' ', @hints));
  221.  
  222.     check_subst_cache($charset);
  223.     defoma_subst_register($Sb{$charset}, $font, $xfont);
  224.     }
  225.  
  226.     return 0;
  227. }
  228.  
  229. sub x_unregister {
  230.     my $font = shift;
  231.     my $hh = parse_hints_start(@_);
  232.     my $facenum = $hh->{FaceNum} || 1;
  233.  
  234.     for (my $f = 0; $f < $facenum; $f++) {
  235.     my $h = parse_hints_subhints_inherit($hh, $f);
  236.     my $charset = $h->{Charset};
  237.  
  238.     next unless (defined($charset));
  239.     
  240.     check_subst_cache($charset);
  241.     defoma_subst_unregister($Sb{$charset}, $font);
  242.     }
  243.     
  244.     defoma_id_unregister($IdX, type => 'real', font => $font);
  245.  
  246.     return 0;
  247. }
  248.  
  249. sub x_install {
  250.     my $font = shift;
  251.     my $id = shift;
  252.     my $depfont = shift;
  253.     my $depid = shift;
  254.  
  255.     my @l = defoma_id_grep_cache($IdObjH, 'installed', f0 => $id);
  256.  
  257.     my @hints = defoma_id_get_hints($IdObjH, $l[0]);
  258.  
  259.  
  260.     defoma_font_register('x-postscript', '<X>/'.$id, $depid, @hints);
  261. }
  262.  
  263. sub x_remove {
  264.     my $font = shift;
  265.     my $id = shift;
  266.     my $depfont = shift;
  267.     my $depid = shift;
  268.  
  269.     defoma_font_unregister('x-postscript', '<X>/'.$id, $depid);
  270. }
  271.  
  272. sub x_main {
  273.     my $com = shift;
  274.  
  275.     if ($com eq 'register') {
  276.     return x_register(@_);
  277.     } elsif ($com eq 'unregister') {
  278.     return x_unregister(@_);
  279.     } elsif ($com eq 'do-install-subst') {
  280.     return x_install(@_);
  281.     } elsif ($com eq 'do-remove-subst') {
  282.     return x_remove(@_);
  283.     } elsif ($com eq 'init') {
  284.     return init();
  285.     } elsif ($com eq 'term') {
  286.     return term();
  287.     }
  288.  
  289.     return 0;
  290. }
  291.  
  292. sub type1 {
  293.     return x_main(@_);
  294. }
  295.  
  296. ###
  297.  
  298. sub xfont_register {
  299.     my $font = shift;
  300.     my $h = parse_hints_start(@_);
  301.  
  302.     my $priority = $h->{Priority} || 0;
  303.     my $cset = $h->{Charset} || return 1;
  304.     $cset =~ s/ .*//;
  305.  
  306.     parse_hints_cut_except($h, 'GeneralFamily', 'Family', 'Weight', 'Shape',
  307.                'Width', 'Charset', 'FontName');
  308.  
  309.     parse_hints_cut($h, 'UniCharset') if ($cset ne 'ISO10646-1');
  310.     
  311.     my @hints = parse_hints_build($h);
  312.  
  313.     defoma_id_register($IdX, type => 'real', font => $font, id => $font,
  314.                priority => $priority, hints => join(' ', @hints));
  315.  
  316.     check_subst_cache($cset);
  317.     defoma_subst_register($Sb{$cset}, $font, $font);
  318.  
  319.     return 0;
  320. }
  321.  
  322. sub xfont_unregister {
  323.     my $font = shift;
  324.     my $h = parse_hints_start(@_);
  325.     my $charset = $h->{Charset};
  326.  
  327.     check_subst_cache($charset);
  328.     defoma_subst_unregister($Sb{$charset}, $font);
  329.  
  330.     defoma_id_unregister($IdX, type => 'real', font => $font);
  331.  
  332.     return 0;
  333. }
  334.  
  335. sub xfont {
  336.     my $com = shift;
  337.  
  338.     if ($com eq 'register') {
  339.     return xfont_register(@_);
  340.     } elsif ($com eq 'unregister') {
  341.     return xfont_unregister(@_);
  342.     } elsif ($com eq 'do-install-subst') {
  343.     return x_install(@_);
  344.     } elsif ($com eq 'do-remove-subst') {
  345.     return x_remove(@_);
  346.     } elsif ($com eq 'init') {
  347.     return init();
  348.     } elsif ($com eq 'term') {
  349.     return term();
  350.     }
  351.  
  352.     return 0;
  353. }
  354.  
  355.  
  356.  
  357.  
  358. 1;
  359.